home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Complete Applications / 4D Programming / 4D Turbo / Soundex.p < prev    next >
Encoding:
Text File  |  1987-10-01  |  1.9 KB  |  86 lines  |  [TEXT/ttxt]
  1. Program SoundParser;
  2.  
  3.  
  4. {$R-}
  5. {$U-}
  6. {$D 4DEX}
  7.  
  8. Uses
  9.     Memtypes, Quickdraw, OSIntf, Toolintf, PackIntf;
  10.  
  11.  
  12. Procedure Parse(var First:str255);
  13.  
  14.     Const
  15.         Designer='This code written by Todd Carper';
  16.         
  17.     Var
  18.         namelength, resultlen, lastcount, count, vcount:longint;
  19.         name, trans, zero, testchar:str255;
  20.         vset:Array[0..6] of str255;
  21.         found, done:Boolean;
  22.  
  23.  
  24.     Begin
  25.  
  26.     {Load the array's with similar sounds.}
  27.  
  28.         vset[0]:='AEHIOUWYaehiouwy';
  29.         vset[1]:='BFPVbfpv';
  30.         vset[2]:='CGJKQSXZcgjkqsxz';
  31.         vset[3]:='DTdt';
  32.         vset[4]:='Ll';
  33.         vset[5]:='MNmn';
  34.         vset[6]:='Rr';
  35.  
  36.         {Initialize remaining variables.}
  37.  
  38.         resultlen:=0;
  39.         lastcount:=0;
  40.         namelength:=Length(First)-1;
  41.         name:=Copy(First,2,namelength);
  42.         count:=0;
  43.         done:=False;
  44.  
  45.         While ((count<namelength) and (Not(done))) do
  46.         begin
  47.             count:=count+1;
  48.             testchar:=Copy(name,count,1);
  49.             found:=False;
  50.             vcount:=-1;
  51.             While ((vcount<6) and (Not(found))) do
  52.             Begin
  53.                 vcount:=vcount+1;
  54.                 If ((Pos(testchar,vset[vcount]))>0) then
  55.                     found:=True;
  56.             End;
  57.    
  58.             If (Not(found)) then
  59.                 vcount:=0;
  60.   
  61.             If ((vcount<>0) and (lastcount<>vcount)) then
  62.             Begin
  63.                 NumToString(vcount, trans);
  64.                    Zero:=Concat(Zero, trans);
  65.                 resultlen:=resultlen+1;
  66.                 If (resultlen=3) then
  67.                     done:=True;
  68.             End;
  69.             lastcount:=vcount;
  70.         End;
  71.  
  72.         While (resultlen<3) do
  73.         Begin
  74.             resultlen:=resultlen+1;
  75.             Zero:=Concat(Zero, '0')
  76.         End;
  77.  
  78.         {Put first character in front of computed code.}
  79.  
  80.         First:=Concat(Copy(First,1,1),Zero);
  81.  
  82.     end;
  83.  
  84. Begin
  85. End.
  86.